home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_click < prev    next >
Encoding:
Text File  |  1991-12-30  |  2.3 KB  |  90 lines
  1. \ Demonstrate double click detection.
  2. \ Change rectangle color if double click.
  3. \
  4. \ Author: Phil Burk
  5. \ Copyright 1988  Delta Research
  6.  
  7. include? newwindow.setup ju:amiga_graph
  8. include? ev.getclass ju:amiga_events
  9.  
  10. ANEW TASK-DEMO_CLICK
  11.  
  12. NewWindow ClickWindow   ( Create a template for the new window. )
  13.  
  14. : NEXT.COLOR  ( -- , paint rectangle next color )
  15.     gr.color@ 3 mod 1+ gr.color! ( use colors 1,2,3,1,2,3,1,2,3 ... )
  16.     0 0 300 100 gr.rect
  17. ;
  18.  
  19. \ Set up your own previous time for better control.
  20. VARIABLE PREVIOUS-MICROS
  21. VARIABLE PREVIOUS-SECONDS
  22.  
  23. \ This flag is used to prevent the first click after a
  24. \ double click to be checked for double clicking.
  25. \ Otherwise, three fast clicks would be treated as
  26. \ two double clicks!
  27. VARIABLE IF-DOUBLED        ( true if last click was double )
  28. VARIABLE IQUIT
  29.  
  30. \ The Intuition routine DoubleClick checks the value set in
  31. \ preferences for Double Click minimum timing.
  32. : CHECK.DOUBLE  ( -- flag , test timing against preferences )
  33.     previous-seconds @ previous-micros @
  34.     ev-last-seconds @ ev-last-micros @
  35.     call intuition_lib doubleclick
  36. ;
  37.  
  38. : PROCESS.EVENT ( class -- done? , process events from IDCMP )
  39.     false iquit !
  40.     CASE
  41.         MOUSEBUTTONS OF   ( check for up or down )
  42.             ev-last-code @ SELECTDOWN =  ( down stroke? )
  43.             IF  if-doubled @     ( first click after double? )
  44.                 IF  false if-doubled !   ( turn off flag )
  45.                 ELSE check.double
  46.                     dup if-doubled !
  47.                     IF  next.color
  48.                     THEN
  49.                 THEN
  50. \ Save time of this DOWN event.
  51.                 ev-last-micros @ previous-micros !
  52.                 ev-last-seconds @ previous-seconds !
  53.             THEN
  54.         ENDOF
  55.  
  56. \ Quit if close box hit.
  57.         CLOSEWINDOW OF true iquit ! ENDOF
  58.  
  59.         warning" CLICK.LOOP -- Unrecognized event!"
  60.     ENDCASE
  61.     iquit @
  62. ;
  63.  
  64. : CLICK.LOOP  ( -- , loop until done )
  65.     BEGIN
  66.         gr-curwindow @ ev.getclass dup
  67.         IF process.event
  68.         THEN
  69.     UNTIL
  70. ;
  71.  
  72. : CLICK  ( -- , Demonstrate double click. )
  73.     gr.init
  74.     ." Click - Hit CLOSEBOX to stop!" cr
  75.     ." Double click in window to change color." cr
  76.     ClickWindow NewWindow.Setup      ( Set defaults for window )
  77.     0" JClick!" >abs  ClickWindow ..! nw_title
  78.     CLOSEWINDOW MOUSEBUTTONS |
  79.     ClickWindow ..! nw_idcmpflags
  80. \
  81. \ Create window from template and make it the current window.
  82.     ClickWindow gr.openwindow gr.set.curwindow
  83.     click.loop
  84. \
  85.     gr.closecurw
  86.     gr.term
  87. ;
  88.  
  89. cr ." Enter:   CLICK     for demo!" cr
  90.